perm filename RHYTH.F4[XX,LCS]5 blob
sn#194614 filedate 1975-12-29 generic text, type T, neo UTF8
00100 C***** SUBRS RHYTH, SETUP, MARKS, DOTS ********
00200
00300 SUBROUTINE RHYTH
00400 DIMENSION R(10,80),POSNT(0/81)
00500 COMMON/DPY/ST(4000),WDS(250),MEDIT,GO /XRN/RN(4000)
00600 COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00700 COMMON /SCX/RHY(4),JALPHA(30),JX,JXX,JZ,IRHY,JD,KA,KB,IZ
00800 COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,
00900 1 NFLG,IXX,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA /FLM/RPOS(2,300)
01000 COMMON/ALF/INP(59),NX,NOTE,JSET,KZ,KX,AVGPOS,RLPOS,RLP2,
01100 1 AVP2,ZX,RE,ZZ,RD,RSTX
01200 C SEE ALSO FILLMS, SETLET AND SETUP RE. /FLM/
01300 COMMON /POS/POS1,POS2 /STF/RSTFAC(-3/4),RSTJ3
01500 EQUIVALENCE (VX(1),X),(VX(2),Y),(VX(7),Z),(POSNT,RN(3801)),
01600 1(NTC,RN(3883)),(VX(3),AB),(VX(4),T),(VX(5),RB),(VX(6),X2)
01700 1,(VX(8),C),(VX(9),S),(VX(10),X3),(RA,RN(3919))
01800 1,(R,RN(3001)),(STUP,RN(3921)),(PS2,RN(3922))
01805 1,(SET4,RN(3920)),(NOSET,RN(3923))
01810 CX 1,(POZ1,RN(3884))
01900
01950 DATA FIB/.75/
01975 C FIB IS FOR PSUEDO-FIBONACCI SPACING
02000 RSTJ3=RSTFAC(IFIX(STAFF))
02200 NX=-1
02300 JX=0
02400 NOTE=0
02500 Y=0
02510 NOSET=0
02600 JSET=0
02700 C STUP IS NEG. IF SETUP IS NOT READY
02900 IF(STUP)GO TO 341
02950 IF(SET4.EQ.STAFF)NOSET=-1
02975 C TO ADD MORE NOTES ON SETUP LINE. WIPES OUT P9 AT END OF SCMSS.
03000 KZ=1
03100 POS2=PS2
03200 C GETS LAST ↑↑ POS. FROM SETUP
03300 JSET=-1
03400 C NEXT NUM.(100) IS LIMIT FOR STF.4 (CAN BE UP TO 300-SEE /FLM/)
03500 DO 9 KX=1,100
03600 9 IF(RPOS(2,KX).GT.0)GO TO 10
03700 10 AVGPOS=RPOS(1,KX)
03800 RLPOS=AVGPOS
03900 KX=KX+1
04000 RLP2=RPOS(1,KX)
04100 343 AVP2=RPOS(2,KX)-.001
04200 IF(AVP2.GT.0)GO TO 341
04300 KX=KX+1
04400 GO TO 343
04500 C AVERAGED AND REAL POSITIONS FROM 'SETUP'
04600
04700 C NEXT FOR NON-SETUP
04800 341 DO 34 K=1,IRHY
04850 Z=ABS(V(K))
04900 CC34 IF(V(K).GT..05)Y=ABS(V(K))+Y
05000 C 88TH NOTES ARE TAKEN AS GRACE NOTES. THEN BECOME 32NDS.
05010 IF(Z.NE.4./88.)GO TO 345
05055 IF(JSET)GO TO 34
05056 C GRACE NOTES SKIPPED IN AUTOMATIC SETUP
05057 CF Y=Y+.125
05059 CF GO TO 34
05077 CF345 Y=ABS(V(K))+Y
05079 345 IF(STUP.LT.-1)Z=Z+(.125-Z)*FIB
05080 C STUP CAN BE SET TO .LT.-1 IN NOTBMS FOR PSUEDO-FIBONACCI SPACE
05081 Y=Y+Z
05088 34 CONTINUE
05100 C Y=TOTAL TIME
05110 CX POZ1=POS1
05115 CX POSNT(0)=POS2
05117 C A SAFEGUARD
05120 C SAVES POS1 FOR POSITIONING MF, CRESC. ETC.
05130 NTC=0
05140 C THE WORD COUNT FOR REAL NOTES.
05200 IF(JSET)GO TO 3421
05300
05400 IF(POS1.LT.POS2)POSX=POS1
05500 C SAVES IT FOR BACKUP
05600 IF(POS1.GE.POS2)POS1=POSX
05700
05800 Z=POS2-POS1
05900 ZX=Z
06000 342 DO 1 K=1,IZ
06100 X=R(1,K)
06200 IF(X.LT.3.)GO TO 1
06300 C JUMP IF NOTE OR REST
06400 IF(X.NE.17.)GO TO 8
06500 C JUMP IF NOT A KEY SIG.
06600 RA=2.+ABS(R(5,K))*2.0
06700 GO TO 6
06800 8 IF(X.NE.4.)GO TO 81
06900 C NEXT IS FOR BAR LINES
07000 RA=3
07050 J=K+1
07100 RE=R(1,J)
07200 IF(RE.EQ.3.)RA=1.5
07300 C A CLEF
07400 IF(RE.EQ.18)RA=2.5
07500 C A METER
07600 IF(RE.NE.1)GO TO 83
07650 IF(AMOD(R(5,J),10.).NE.0)RA=4.5
07700 C FINDS ACCI ON NEXT NOTE.
07800 83 IF(K.EQ.IZ)RA=0
07900 C END OF STAFF
08000 GO TO 6
08100 82 RA=6
08200 GO TO 83
08300 81 IF(X.EQ.18)GO TO 82
08400 RA=7.
08500 C FOR CLEFS
08600 IF(K.LT.3)RA=9.
08700 C THE FIRST CLEF IS NOT MINI
08800 6 RA=RA*RSTJ3
08900 C SO SPACE WILL DEPEND ON SIZE OF STAFF
09000 Z=Z-RA
09100 R(8,K)=RA
09200 C STORES SPACE NUM THAT MUST BE GIVEN BACK
09300 1 CONTINUE
09400 C SUBTRACTS SPACE FOR CLEF OR BAR. WILL ADD BOTH LATER.
09500 C POS1 AND Z ARE FOR RHYTHMIC SPACING
09700 C SPACE FOR NON-NOTES
09800 134 FORMAT(' **** MISMATCH WITH SPACING STAFF')
09900 3421 K=0
10000 IF(ABS(Y-RA).LE..001)GO TO 3
10050 IF(JSET)TYPE 134
10100
10200 C LOOP TO END
10300 3 K=K+1
10400 C K IS COUNTER
10600 R(7,K)=0
10700 RE=R(1,K)
10800 IF(RE.LE.2.)GO TO 2
10900 RD=R(8,K)
11000 R(8,K)=0
11100 IF(JSET)GO TO 71
11200
11300 7 IF(K.EQ.IZ)POS1=POS2
11400 IF(R(1,K-1).GT.2.)GO TO 73
11450 IF(K.EQ.1)GO TO 73
11475 IF(RE.EQ.4.)GO TO 73
11500 Z=Z+RD/3.
11600 C RETURNS 1/3 OF THE SPACE IF PREV. ITEM IS NOTE OR REST
11700 POS1=POS1-RD/3
11800 C THIS CAN RESULT IN OVERLAP WHICH MUST BE EDITED OUT.!!
11900 73 R(3,K)=POS1
12000 72 POS1=POS1+RD
12100 C ABOVE SECTION LEAVES ROOM FOR CLEF OR BAR
12200 GO TO 337
12300
12400 C 40??? 50???? WHY NOT 100?
12600 71 DO 74 J=KZ,80
12700 74 IF(RE.EQ.-RPOS(2,J))GO TO 75
12800 POS=R(3,K-1)+4
12900 GO TO 76
13000 75 POS=RPOS(1,J)
13100 KZ=J+1
13200 C FOUND SAME TYPE OF ITEM.
13300 76 R(3,K)=POS
13400 GO TO 337
13500
13600 2 JX=JX+1
13700 21 AB=V(JX)
13710 J=9
13800 IF(RE.NE.2)GO TO 121
13850 V(JX)=-AB
13900 C SHOWS RESTS IN AUTO. BEAM SECTION.(ASSUMES REST WAS A + NUMB.)
13920 J=7
14000 121 IF(R(8,K).GE.-1.)R(J,K)=AB
14100 C STORES RHYTH VALUE FOR LATER USE IN PART EXTRACTOR IF NOT CHORD NOTE.
14200 IF(AB.GT..05)GO TO 210
14300 R(3,K)=-1.
14400 RA=100
14500 T=R(4,K)
14600 IF(T)RA=-RA
14700 R(4,K)=T+RA
14800 R(8,K)=1000
14900 C 1000 IN P8 PUTS IN SLASH ON TAIL
15000 C FOUND A GRACE NOTE (88TH NOTE)
15010 RA=R(5,K)
15020 IF(RA.GE.20)R(5,K)=RA-10.
15030 IF(RA.LT.20)R(5,K)=RA+10.
15040 C TURNS STEM OVER.
15050 R(7,K)=1
15100 IF(JSET)GO TO 337
15125 AB=.125
15150 C IT USED TO JUMP. NOW MAKES SPACE FOR GRACE NOTES AS 32NDS.
15200 210 RB=0
15300 CC IF(JSET.GE.0.AND.SET4.LT.0)R(8,K)=-AB-1000.*R(8,K)
15400 C FOR AUTOMATIC SETUP
15500 JZ=K
15600 C JZ WILL BE USED NEAR END
15710 3634 IF(AMOD(AB,.1875).EQ.0)GO TO 122
15755 IF(AMOD(AB*10.,1.5).EQ.0)GO TO 122
15800 C .1875 FINDS SINGLE DOTS ON NOTES (.15 FOR QUINTS) (*10 FOR ROUNDOFF!)
15900 IF(AMOD(AB,.4375).NE.0)GO TO 22
16050 T=20
16100 GO TO 322
16250 122 T=10
16300 322 IF(RE.EQ.2.)GO TO 35
16450 R(7,K)=T
16500 C PUTS ONE OR TWO DOTS
16600 C DOTS THE NOTE.
16700 GO TO 36
16800
16900 35 R(6,K)=T/10.
17000 C ADDS DOT TO REST.
17100 36 RB=AB/3.
17200 IF(T.NE.1)RB=(4*AB)/7
17300 C TO KEEP TAIL ON DOTTED NOTE
17400
17500 22 POS=POS1
17600 IF(JSET.EQ.0)GO TO 220
17700
17800 C NEXT IS FOR SETUP
17900 222 IF(NOTE)GO TO 223
18000 C FIRST TIME A NOTE IS FOUND.
18100 NOTE=-1
18200 POS1=RLPOS
18300 Z=POS2-POS1
18400 C RESETS SPACE AVAILABLE, ZZ IS SPACE FOR NON-NOTES
18500 223 IF(POS1.LT.AVP2)GO TO 221
18600 224 KX=KX+1
18700 C???? OCT, 73 IF(NX.EQ.0)GO TO 225
19000 IF(NX)RLP2=RPOS(1,KX)
19100 NX=-1
19200 225 IF(RPOS(2,KX-1))GO TO 227
19300 RLPOS=RPOS(1,KX-1)
19400 AVGPOS=AVP2
19500 227 AVP2=RPOS(2,KX)-.001
19600 IF(AVP2.GT.0)GO TO 223
19700 C 0 IN RPOS=POS. OF NON-NOTE
19800 CC****** WHY NEEDED?? 6/74 *** IF(RLP2.GE.POS1)NX=0
19900 NX=0
20000 CC*****↑↑↑↑ CHANGED FROM ABOVE *** 6/74
20100 GO TO 224
20200 221 POS=(POS1-AVGPOS)*(RLP2-RLPOS)/(AVP2-AVGPOS)+RLPOS
20400 220 R(3,K)=POS
20800 4634 IF(RE.NE.1)GO TO 44
20805 IF(POS.EQ.POSNT(NTC))GO TO 2634
20807 C SKIPS OTHER CHORD NOTES.
20810 NTC=NTC+1
20820 POSNT(NTC)=POS
20830 C SAVES IT FOR NUMBS ABOVE NOTES, ETC.
20850 2634 IF(AB.GE.2)GO TO 4
20875 IF(AB.EQ.1.333333333)GO TO 4
20900 44 L=K+1
21000 IF(R(8,L).GE.0)GO TO 1634
21050 IF(R(1,L).NE.1.)GO TO 1634
21100 C JUMP IF NOT DOUBLE STOP
21300 C DELETES STEM FROM WHOLE NOTE CHORD (NOW DONE IN NOTWRT IF P7=1)
21400 R(3,L)=R(3,K)
21500 K=L
21700 CC R(8,K)=0
21800 GO TO 3634
21900 C LOOPS BACK TO PICK UP MORE CHORD NOTES
22000
22100 C 'WHITENS' HALF, WHOLE AND TRIPLET HALF NOTES.
22200 4 RA=-R(6,K)
22300 IF(RA.EQ.0)RA=-1
22400 IF(AB.LT.4.)GO TO 144
22450 RP=1
22460 IF(AB.GE.8)RP=2
22500 R(7,K)=R(7,K)+RP
22600 C +1=WHOLE NOTE WILL PRINT +2=DBL WHL NT.
22700 CC NOT NEEDED BECAUSE OF ABOVE. RA=-2.
22800 144 R(6,K)=RA
22900 GO TO 44
23000
23100 1634 T=POS1
23110 RP=AB
23120 IF(STUP.LT.-1)RP=AB+(.125-AB)*FIB
23130 C FOR PSUEDO-FIB. SPACING
23140 POS1=RP/Y*Z+POS1
23200 CF POS1=AB/Y*Z+POS1
23300 CZ GO TO 1636
23400 CZ IF(JSET)GO TO 1636
23500 CZ RP=6.
23600 CZ IF(AMOD(R(5,K+1),10.0).EQ.0)RP=3.
23700 C 3 SPACES IF NO ACCID. ON NEXT NOTE, OTHERWISE 6.
23800 CZ RA=POS1-T
23900 CZ RSTX=RP*RSTJ3
24000 CZ IF(RA.GT.RSTX)GO TO 1636
24100 C JUMP IF NOTES ARE FAR ENOUGH APART
24200 CZ RA=RSTX-RA
24300 C THE DIFFERENCE
24400 CZ Z=Z-Z*RA/(POS2-POS1)
24500 C REDUCES TOTAL SIZE Z
24600 CZ POS1=T+RSTX
24650 1636 IF(ABS(R(4,K)).GE.100.0)GO TO 337
24675 C LEAVE TAILS ON GRACE NOTES ALONE.
24700 T=0
24800 RA=AB-RB
24810 IF(RA.EQ.4./6.)GO TO 535
24815 IF(RA.EQ.4./7.)GO TO 535
24817 IF(RA.GT..75)GO TO 535
24820 C KEEPS TAILS OFF TRIPLETS, QUINTS, SEPTS.
24900 DO 534 N=1,4
25000 534 IF(RA.LE.RHY(N))T=N
25300 C DELETES STEM FROM WHOLE NOTES. (NOW DONE IN NOTWRT IF P7=1)
25400 535 IF(R(1,JZ).EQ.1.)GO TO 334
25500 R(4,JZ)=0
25600 C SETS REST
25650 IF(AB.LT.2)GO TO 536
25700 T=-1
25800 IF(AB.GE.4)T=-2
25810 IF(AB.GE.8)T=-3
25855 C -1=HLF RST, -2=WHOLE, -3=DBL WHL RST
25900 C WON'T DO DOUBLE DOTTED WHOLE NOTES.
26000 536 R(5,JZ)=T
26100 GO TO 337
26200 C******* 4/74 NEW WAY TO FIND TAILS
26300 C OMITS RESTS (REALLY???)
26400 334 R(7,JZ)=T+R(7,JZ)
26500 337 IF(K.LT.IZ)GO TO 3
26600 DO 335 K=IZ,1,-1
26700 IF(R(3,K).GE.0)GO TO 335
26800 IF(K.NE.IZ)GO TO 336
26900 R(3,K)=POS2-4.
27000 GO TO 335
27010 336 N=K-1
27020 1336 RA=R(3,N)
27030 IF(RA.GT.0)GO TO 2336
27040 N=N-1
27050 GO TO 1336
27060 C GO BACK IF MORE GRACE NOTES.
27065 2336 T=R(3,K+1)
27070 RB=T-RA
27075 RA=3
27080 IF(RB.LE.3)RA=RB/3.
27190 R(3,K)=T-RA
27200 335 CONTINUE
27300 K=0
27400 45 K=K+1
27500 C NEXT IS TO ARRANGE DOTS.
27600 IF(R(7,K).LT.10)GO TO 451
27700 RA=R(3,K)
27800 DO 452 M=K+1,IZ
27900 IF(R(3,M).NE.RA)GO TO 453
28000 C JUMP IF NOT CHORD NOTE.
28100 IF(ABS(R(6,M)).LT.30.)GO TO 452
28200 C JUMP IF NOTE IS NOT ON LEFT SIDE OF UPWARD STEM
28300 IF(R(4,M)-R(4,M-1).NE.2)GO TO 452
28400 IF(AMOD(R(4,M),2.).NE.0)R(7,M)=AMOD(R(7,M),10.)
28500 C TAKES AWAY DOT IN CERTAIN CASES TO AVOID CONFUSION.
28600 452 CONTINUE
28700 453 K=M-1
28800 451 IF(K.LT.IZ)GO TO 45
28900
28910 N=IZ
29000 IF(JSET)GO TO 13
29050 CC IF(SET4.GE.0)GO TO 13
29100 CC M=IZ
29200 CC RA=-1
29300 CC DO 23 K=1,IZ
29400 CC M=M+1
29500 CC IF(R(3,K).EQ.RA)GO TO 177
29550 CC IF(ABS(R(4,K)).LT.100)GO TO 123
29600 CC177 M=M-1
29700 CC GO TO 23
29800 CC123 RA=R(3,K)
29900 C TO CATCH DBL STOPS AND MINI-NOTES
30000 CC DO 323 L=1,9
30100 CC323 R(L,M)=R(L,K)
30200 CC R(2,M)=4
30600 CC23 CONTINUE
30700 CC IZ=M
30800 C ABOVE SETS UP STAFF 4 IF IT WASN'T ALREADY
30810 13 NTC=NTC+1
30820 CX POSNT(NTC)=POS2
30840 POSNT(NTC)=200
30860 CX POSNT(0)=POZ1
30880 POSNT(0)=0
30900 IF(IREAD)RETURN
31000 DIMENSION ISU(390)
31100 COMMON R2,JH,CENTR,J2,R3,R4,R5,RJQ(17),J3,JQ(19)
31200 1 /POSI/STFF(-3/4),JJ2,POSQ /FRMT/FQZ(3),IREAD
31300 EQUIVALENCE (J5,JQ(2)),(ISU,ST(3600))
31400 CALL DPYSET(3,ISU,390)
31500 CALL DPYBRT(6)
31550 J2=STAFF
31575 POSQ=STFF(J2)
31600 J5=1
31700 CC RA=-100
31800 R4=20
31900 C R5=0=1 STANDARD SIZE IS USED.
32000 DO 131 K=1,NTC-1
32100 CC IF(R(1,K).NE.1)GO TO 131
32125 CC IF(R(3,K).EQ.RA)GO TO 131
32150 CC RA=R(3,K)
32200 CC R3=RHORZ(RA)
32210 R3=RHORZ(POSNT(K))
32300 CALL PNUM
32400 C GOES TO DRAW A NUMBER OVER A NOTE
32500 J5=J5+1
32600 IF(J5.EQ.10)J5=0
32700 131 CONTINUE
32800 132 CALL DPYOUT(3)
32900 CALL SETPOG(1)
33000 END
33100
33200 C SETUP ALLOWS YOU TO SET UP RHYTHMS ON STAFF 4 FOR SPACING ALL OTHERS.
33300 SUBROUTINE SETUP
33330 INTEGER PWDS
33400 COMMON/FLM/RPOS(2,300) /ALF/JX,X,RD,RNL,RN6,M,A,RB,RC,
33500 1 INP(64) /SCM/V(78),IV,LCNT,STAFF,LIST(200),REND
33600 COMMON /PTR/PWDS(250),ITEM,L,I,IX
33700 COMMON/DPY/ST(4000),WDS(250),MEDIT,GO /XRN/RN(4000)
33800 EQUIVALENCE (RA,RN(3919)),(ENDP,RN(3922)),(SETFLG,RN(3921))
33900 1,(SET4,RN(3920))
34000
34100 C RHYTHMIC VALUES ARE SAVED IN P9 OF NOTES AND P7 OF RESTS.
34300 SETFLG=-1
34400 C THIS SENDS INFO TO SUBR. NOTES
34510 IF(SET4.GT.4)RETURN
34555 C **** BE SURE SETUP STAFF HAS SPACE VALUES IN NOTES AND RESTS!!!
34570 IF(ITEM.EQ.0)RETURN
34600 JX=0
34650 CC RNL=0
34700 RA=0
34800 DO 9534 K=1,ITEM
34900 L=PWDS(K)
35000 IF(RN(L+2).NE.SET4)GO TO 9534
35100 RD=RN(L+1)
35200 IF(RD.LT.5)GO TO 5
35300 IF(RD.LT.17)GO TO 9534
35350 5 IF(RD.GT.2)GO TO 6
35405 RC=7
35406 IF(RD.EQ.2)RC=5
35407 IF(RN(L).LT.RC)GO TO 9534
35410 M=9
35411 IF(RD.EQ.2)M=7
35412 IF(RN(L+M).EQ.0)GO TO 9534
35420 C FOR OTHER NOTES ON SPACING STAFF.
35425 IF(RN(L+8).EQ.1000.)GO TO 9534
35426 C SKIPS MINI-NOTES
35430 GO TO 7
35437 C SKIPS 'OTHER' CHORD TONES (I.E. P9=0 IN A NOTE)
35480 6 IF(RD.NE.3)GO TO 8
35490 IF(RN(L).LT.3)GO TO 7
35500 IF(RN(L+5).GT.3)GO TO 9534
35520 C SKIPS IF NOT A REAL CLEF
35540 GO TO 7
35560 8 IF(RD.NE.4)GO TO 10
35580 IF(RN(L).GT.2)GO TO 9534
35600 C SKIPS IF NOT BARLINE (I.E. ONLY 4 PARAMS)
35610 10 IF(RD.NE.2)GO TO 7
35620 IF(RN(L).LT.5)GO TO 9534
35630 IF(RN(L+7).EQ.0)GO TO 9534
35700 7 JX=JX+1
35800 RPOS(1,JX)=RN(L+3)
35900 IF(RD.GT.2)GO TO 3
36200 C JUMP WHEN TIME VALUES ARE IN P8
36441 RC=RN(L+M)
36473 C FOR VALUES AUTOMATICALLY SET. ALLOWS NON-DUPLE UNITS IN SETUP
38200 277 RA=RA+RC
38300 C SUM OF RHYTHS
38400 GO TO 77
38800 3 RC=-RD
38900 77 RPOS(2,JX)=RC
39000 C RC IS RHYTHMIC VALUE OF NOTE.
39100 9534 CONTINUE
39200 C NEXT PUTS ITEMS IN PROPER ORDER IF THEY WEREN'T ALREADY
39300 C*** 2ND NOTE OF DBL STOP CAN'T!! HAVE RHYTH. VALUE *******
39325 IF(RA.EQ.0)RETURN
39350 C RA=0 MEANS DIDN'T FIND RHYTHMS ON SPACING STAFF.
39400
39500 CALL SORT2(RPOS,JX)
39600 ENDP=200.
39700 IF(RPOS(2,JX))ENDP=RPOS(1,JX)
39800 DO 1 L=1,JX
39900 1 IF(RPOS(2,L).GT.0)GO TO 4
40000 4 RD=RPOS(1,L)
40100 RB=ENDP-RD
40200 C TOTAL SPACE FROM 1ST NOTE TO END OF LINE
40300 RC=RPOS(2,L)
40400 RPOS(2,L)=RD
40500 C REAL AND AVERAGED POSITIONS OF 1ST NOTE ARE THE SAME.
40600 DO 2 K=L+1,JX
40700 RE=RPOS(2,K)
40800 IF(RE)GO TO 2
40900 RD=RC/RA*RB+RD
41000 RC=RE
41100 RPOS(2,K)=RD
41200 2 CONTINUE
41300 C 1,K=REAL POS. 2,K=AVERAGED POS.
41400 C IN RHYTH: POS=(P1-AVG2)*(RL2-RL1)/(AVG2-AVG1)+RL1
41500 JX=JX+1
41600 RPOS(1,JX)=ENDP
41700 RPOS(2,JX)=ENDP
41800 SETFLG=0
41900 C THIS FOR NOTES AND RHYTH
42000 END
42100
42200 SUBROUTINE MARKS(RA)
42300 COMMON/ALF/INP(72),ML
42400 DIMENSION MKS(13)
42500 DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R'/
42600 EQUIVALENCE (MF,MKS(3)),(MH,MKS(9)),(MP,MKS(11)),(MM,MKS(5))
42610 1,(MC,MKS(12)),(MR,MKS(13)),(MI,MKS(10))
42700 RA=99
42800 DO 16 JM=1,72
42900 16 IF(INP(JM))GO TO 17
43000 C DIDN'T FIND MORE LETTERS
43100 RETURN
43200 17 N=INP(JM)
43300 ML=INP(JM+1)
43400 M=INP(JM+2)
43500 DO 1 K=1,13
43600 1 IF(N.EQ.MKS(K))GO TO 2
43700 C DID NOT FIND A LETTER
43800 RETURN
43850 C 4=W(EDGE),5=A(CCENT),26=FE(RMATA),7=S(TACCATO),9=T(ENUTO)
43862 C 11=D(OWNBOW), 12=U(PBOW),13=H(ARMONIC),14=PL(US),15=TH(ESIS)
43871 C 16=AR(SIS),17=MO(RDANT)
43881 C 18=I(NVRTD MORD), ---,20=TR(ILL), >39=PPP, PP, CRESC., ETC.
43885 C 80=ACC(EL.)
43900 2 GO TO(120,10,12,120,4,11,15,15,15,21,12,80,81),K
44005 12 IF(ML.EQ.'L')GO TO 120
44010 C ↑↑↑ PLUS
44012 IF(N.EQ.MF)GO TO 121
44015 RA=42
44020 IF(ML.NE.MP)GO TO 18
44025 RA=41
44030 IF(M.EQ.MP)RA=40
44035 C FOR P, PP, PPP -- 42, 41, 40
44040 GO TO 18
44050 15 IF(ML.EQ.MI)GO TO 82
44075 K=K+1
44100 120 K=K+3
44200 8 RA=K
44300 C YOU CAN TYPE # OR NAME OF MARK
44400 18 DO 6 JM=1,72
44500 N=INP(JM)
44600 INP(JM)=' '
44700 C BLANKS OUT USED LETTERS
44800 IF(N.EQ.'/')RETURN
44825 IF(N.EQ.'*')RETURN
44837 6 IF(N.EQ.';')RETURN
44850 4 IF(ML.EQ.'O')GO TO 20
44900 RA=43
44950 IF(ML.EQ.MF)RA=50
45000 C ↑↑↑↑↑ MP, MF
45050 GO TO 18
45205 121 IF(ML.EQ.'E')GO TO 120
45210 C ↑↑↑ FERMATA
45215 RA=51
45220 IF(ML.NE.MF)GO TO 18
45225 RA=52
45230 IF(M.EQ.MF)RA=53
45235 C F, FF, FFF -- 51, 52, 53
45240 GO TO 18
45300 CC5 K=14
45400 CC GO TO 8
45410 10 IF(ML.EQ.MC)GO TO 84
45500 IF(ML.NE.MR)GO TO 120
45550 19 K=13
45600 C 'R' FOR ARSIS
45700 GO TO 120
45800 11 IF(ML.EQ.MH)K=12
45900 C THESIS
45950 IF(ML.EQ.MR)K=17
46000 GO TO 120
46010 20 K=17
46020 GO TO 8
46030 21 K=18
46040 GO TO 8
46042 80 IF(ML.EQ.'+')GO TO 85
46043 C FOR /N1 C+ N2/ ETC. -- CRESC. AND DECRESC. LINES.
46044 IF(ML.EQ.'-')GO TO 86
46065 RA=70
46067 C CRESC.
46070 GO TO 18
46072 85 RA=200
46074 GO TO 18
46076 86 RA=199
46078 GO TO 18
46080 81 RA=37
46090 C RIT.
46100 GO TO 18
46110 82 RA=82
46120 C DIM.
46125 GO TO 18
46130 84 RA=80
46140 C ACCEL.
46150 GO TO 18
46160 END
46200
46300 SUBROUTINE DOTS(L,Z,X,RC)
46400 C M=BASIC RHY. NX=NUM OF DOTS
46500 COMMON /XRN/RN(4000)
46600 RC=4./2.**(Z+2.)
46700 IF(RN(L).LT.4)RETURN
46750 IF(X.EQ.0)RETURN
46800 C -2=WHOLE, -1=HALF, 0=QUART, 1=EIGHTH, 2=SIXTEENTH, ETC.
46900 B=RC
47000 DO 100 NN=1,IFIX(X)
47100 B=B/2
47200 100 RC=RC+B
47300 END